COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 MacLisp portion of the E/MacLisp Interface.
C00005 00003	 Mailbox Manipulation Routines
C00014 00004	 Storage for Mail routines
C00015 ENDMK
C⊗;
;;; MacLisp portion of the E/MacLisp Interface.
;;;
;;; An SFA/MAIL based system for communicating with
;;; an unstructured, standard text editor.
;;;
;;;	Mail
;;;	wd1:	Job# sending message
;;;	wd2:	type of message
;;;		0,,1:	SEXPs
;;;		0,,2    control (meta) chars to follow (E macro format)
;;;		0,,4:   Ready for answer
;;;		0,,10:  not ready for answer
;;;		0,,100: initiating a conversation
;;;		1,,0:   Continuation needed
;;;		2,,0:	Short (fits in the next =30 words, ends with null byte
;;;			       or falls off)
;;;		
;;;	wd3:	-length (in bytes?),,address of block

(declare (mapex t)
	 (fasload util fas dsk (aid rpg))
	 (special em:jobnum)
	 (fixnum em:jonum))

(defun em:negotiate (n)
 (em:wait-for-mail)
 (cond ((eq (em:jobname) 'E)
	(em:acknowledge))
       (t (error 'fail-act '|Bad jobname|))))
 
(defun em:toplevel ()
       (let ((em:sfa (sfa-create)))
	    (em:negotiate)
	    (do ((message-type (em:getmail)
			       (em:getmail))
		 (sexp))
		(())
		(*catch 'em:toplevel
			(caseq message-type
		       (sexps
			(em:eval-file em:sfa))
		       (control
			(em:eval-control-file em:sfa)))
		       
(defun em:eval-file (sfa)
 (let ((eof (ncons ())))
      (do ((form (read sfa eof)
		 (read sfa eof)))
	  ((eq form eof) t)
	  (print (eval form) sfa))))

(defun em:eval-control-file (sfa)
 (do ((char (tyi sfa -1)
	    (tyi sfa -1)))
     ((= char -1) t)
     (caseq char
	((#o302 #o342)
	 (break ↑B t))
	((#o307 #o347)
	 (*throw 'em:toplevel t))
	)))

(defun em:create-buffer ()
 (*array 'em:buffer 'fixnum #o1000)
 (maknum (get 'em:buffer 'array)))

(defun em:flush-buffer ()
 (remprop 'em:buffer 'array))
;;; Mailbox Manipulation Routines
;;;	Mail
;;;	wd1:	Job# sending message
;;;	wd2:	type of message
;;;		0,,0	Short (fits in the next =30 words, ends with null byte
;;;			       or falls off)
;;;		0,,1:	SEXPs
;;;		0,,2    control (meta) chars to follow (E macro format)
;;;		0,,4:   Ready for answer
;;;		0,,10:  not ready for answer
;;;		0,,100: initiating a conversation
;;;		0,,200:	interrupt. do <esc>i <char>
;;;		0,,400: suicide
;;;		1,,0:   Continuation needed
;;;		
;;;	wd3:	-length (in bytes?),,address of block

(lap em:getmail subr)
(args em:mailbox (nil . 0))

	(mail 2 mailbox)		;SRCV
	(jrst 0 false)
	(movei b 'nil)
	(movem b (special sail-mail-interrupt))
	(move a mailbox)		;get the jobnum
	(movem a jobread)
	(came a jobnum)			;correct one?
	(jrst 0 false)
	(move tt (+ mailbox 1));type bits
	(tlne tt 2)
	(pushj p transfer-buffer)
	(jrst 0 em:mailtype)

true	(movei a 't)
	(popj p)
false	(movei a 'nil)
	(popj p)

(entry em:mailtype subr)
(args em:mailtype (nil . 0))
	(movei b 'nil)
	(movem b (special -em:control-chars-))
	(move tt (+ mailbox 1));type bits
	(movei a 'nil)		;short flag
	(tlne tt 2)
	(movei a 't)
	(movem a (special -em:shortp-))
   	(movei a 'nil)
	(tlne tt 1)		;continuation expected?
	(movei a 't)
	(movem a (special -em:continuation-))
	(trne tt 1)
	(jrst 0 sexps)		;sexps
	(trne tt 2)
	(jrst 0 cntrl)		;control chars
	(trne tt 4)
	(jrst 0 ready)		;ready
	(trne tt 10)
	(jrst 0 nready)		;not ready
	(trne tt 100)
	(jrst 0 initiate)	;initiate conversation
	(trne tt 200)
	(jrst 0 interrupt)	;some interrupt
	(tlne tt 1000)		;ok
	(jrst 0 ok)
	(movei a 'unknown)
	(popj p)
sexps	(movei a 'sexps)
	(popj p)
cntrl   (movei a 'control-chars)
	(movei b 't)
	(movem b (special -em:control-chars-))
	(popj p)
ready	(movei a 'ready-for-answer)
	(popj p)
nready  (movei a 'not-ready-for-answer)
	(popj p)
initiate(movei a 'initiate-conversation)
	(popj p)
interrupt
	(movei a 'interrupt)
	(popj p)
ok
	(movei a 'ok)
	(popj p)

(entry em:waitmail subr)
(args em:waitmail (nil . 0))
	(mail 1 mailbox)
	(movei a 't)
	(popj p)

(entry em:mail-sfa subr)
(args em:mail-sfa (nil . 3))
	(movei a 0 b)	;operation type ignore the object
	(caie a 'which-operations)
	(jrst 0 t1)
	(movei a '(tyi tyo force-output open close untyi))
	(popj p)
t1	(cain a 'tyi)		;tyi?
	(jrst 0 em:mail-tyi)
	(cain a 'tyo)		;tyo?
	(jrst 0 em:mail-tyo)
	(cain a 'force-output)	;force output?
	(jrst 0 em:mail-force-output)
	(cain a 'untyi)		;untyi?
	(jrst 0 em:mail-untyi)
	(cain a 'open)		;open?
	(jrst 0 em:mail-open)
	(cain a 'close)		;close?
	(jrst 0 em:mail-close)
	(movei a 'nil)
	(popj p)

;;; TYI

em:mail-tyi
	(sosg 0 inbytes)
	(pushj p mail-refresh)
inmailok
	(movei a 't)
	(camn a (special -em:control-chars-))
	(jrst 0 read-control-chars)
	(ildb tt inpoint)	;get byte
	(cain tt 0)		;0 means get another buffer
	(push p inmailok)
	(jrst 0 mail-refresh)
	(jsp t fxcons)
	(popj p)

;;; TYO

em:mail-tyo
	(movei a 0 a)
	(idpb a outpoint)	;put it there
	(sosle 0 outbytes)	;ready to send?
	(pushj p mail-sendit)
	(movei a 't)
	(popj p)

;;; FORCE OUTPUT

em:mail-force-output
mail-sendit
	(movei a outmail)	;address of buffer
	(movem a (+ mailbox 2))
	(move a outbytes)	
	(caile a (- #o1000 30.));short enough
	(jrst 0 long-message)	;nope
	(hrlzi a outmail)
	(hrri  a (+ mailbox 3))
	(blt a (+ mailbox 30.))	;move to the right place
	(move a short-message-bits)
	(jrst 0 send-message)
long-message
	(move a long-message-bits)
send-message
	(move a outbytes)
	(idivi a 5)
	(caie a 0)
	(addi a 1)
	(movns a)
	(hrlzm a (+ mailbox 2))
	(movei a outmail)
	(hrrm a (+ mailbox 2))
	(mail 0 mailbox)	;mail it
	(jrst 0 false)
	(move a outpointemp)	;setup output byte count
	(movem a outpoint)
	(movei a #o5000)
	(movem a outbytes)
	(pushj p em:wait-mail)	;wait for acknowledgment
	(pushj p em:mailtype)
	(came a 'ok)
	(jrst 0 false)
	(jrst 0 true)

read-control-chars
	(ildb t inpoint)
	(sos 0 inbytes)
	(setz tt)
	(camn t alpha)
	(move tt control-mask)	;saw an α
	(jrst 0 read-meta)	;now maybe a β?
	(camn t beta)		;saw a β, so now the char
	(ior t meta-mask)
read-char
	(ildb t inpoint)
	(sos 0 inbytes)
	(ior tt t)
	(jsp t fxcons)
	(popj p)
read-meta
	(ildb t inpoint)
	(sos 0 inbytes)
	(camn t beta)
	(ior t meta-mask)
	(jrst 0 read-char)

;;; This routine gets fresh mail to initialize the reader
mail-refresh
	(pushj p em:waitmail)	;wait for response
	(pushj p em:getmail)	;get the mail
	(movei b #o5000)	;max bytes
	(movem b inbytes)
	(move b (special -em:short-))
	(camn b 't)		;short
	(pushj p 'initialize-short)
	(movei c 'nil)
	(cain a 'control-chars)	;control chars?
	(movei c 'T)
	(movem c control-chars)	
	(move a inpointtem)	;byte pointer template
	(movem a inpoint)
	(popj p)

initialize-short
	(hrlzi a inmail)
	(hrri a (+ mailbox 3))
	(blt a (+ inmail 30.))	;move the stuff
	(movei a 150.)
	(movem a inbytes)
	(popj p)

;;; This routine does a jobread into the right spot.

transfer-buffer
	(movei tt jobread)
	(move a (+ mailbox 2))
	(movem a (+ jobread 1))
	(jobrd tt)
	(jrst 0 false)
	(jrst 0 true)
;;; Storage for Mail routines

jobnum	(0)
mailbox	(block 32.)	;mail
inmail	(block 1000)	;text
outmail	(block 1000)	;text
stack (block 20)
untyipdl (777760←22 0 stack)
untyif (0)
inpoint (1034←24 0 inmail)
inpointem (1034←24 0 inmail)
inbytes (0)
outpoint (1034←24 0 outmail)
outpointem (1034←24 0 outmail)
outbytes (0)
control-chars (0)
jobread	(0)
	(0)
	(0 0 inmail)